package password_rest_service::Controller::File;
#Hursk Insight
#Copyright (c) 2009 The Hursk Group, LLC. All rights reserved.
#
#www.hursk.com
#
#hurskgroup@hursk.com
#
#This software is distributed WITHOUT ANY WARRANTY; without even
#the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
#PURPOSE.

our $VERSION = 0.1;
BEGIN {
    #Set up tempfile creation:
    use File::Temp qw/ tempfile tempdir /;
    my $newlevel = File::Temp->safe_level( File::Temp::HIGH );#Set a high safety level
    die "Could not change to high security in File.pm"
        if $newlevel != File::Temp::HIGH;    
}

use strict;
use warnings;
use parent qw/Catalyst::Controller::REST Catalyst::Controller/;
use POSIX qw/ setsid /;

use Data::Dumper;
use XML::Twig;
use MIME::Base64;
use HTML::Entities;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep );

=head1 NAME

password_rest_service::Controller::REST - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut


=cut

=head2 auto : Private

Checks process load.

=cut

#By placing  code inside the auto method of File.pm
#it will be called for every request that is received by this controller.

sub auto : Private {
    my ($self, $c) = @_;
    
    #If _check_process_load returns 0, stop processing this action and return.
    #Otherwise, if it returns 1, keep processing:
    return 0 unless _check_process_load($self, $c);
}

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    $c->response->body('This is the REST::Password::File::Line controller.');
}

sub _check_process_load : Private {
    my ($self, $c) = @_;
    _check_c($c);
    
    my $t0_line_POST = [gettimeofday];
    
    my @john_processes
        = $c->model('password_rest_service::SharedVars')
            ->get_column('john_process')->all;
    
    my $max_john_processes = scalar @john_processes;
    
    warn "TOTAL JTR PROCESSES: $max_john_processes\n";
    
    #Store process load in $self:
    $self->{process_load} = $max_john_processes;
    
    if (not $c->config->{requests}->{requests_limit}){
        _xml_status($c, $t0_line_POST,
                    request => {
                        status => 'WAIT'
                    },
                    response => {
                        process_load => $self->{process_load},
                        status => "Internal server error. "
                                ."requests_limit not defined "
                                ."in application config file.",
                        HTTP_code => 503,
                        HTTP_status => 'Service Unavailable',
                    }
                );
        return 0;
    }
    
    if ($self->{process_load} and ($self->{process_load} > $c->config->{requests}->{requests_limit} ) ){
        _xml_status($c, $t0_line_POST,
                    request => {
                        status => 'WAIT'
                    },
                    response => {
                        process_load => $self->{process_load},
                        status => "The system has reached the maximum number "
                            ."of concurrent requests for this resource. "
                            ."Please try your request again at a later time.",
                        HTTP_code => 503,
                        HTTP_status => 'Service Unavailable',
                    }
                );
        return 0;
    }
    else {
        return 1;
    }
}

sub line :Local :ActionClass('REST'){
    my ($self, $c, $id) = @_;
    $c->stash(id => $id);
}

sub _urlsafe_b64encode : Private {
    my $c = shift;
    my $t0 = [gettimeofday];
    my $line = shift
        or do {
            print {*STDERR} "line was not passed to _urlsafe_b64encode";
            return 0
        };
    _check_c($c);
    
    eval { encode_base64($line, '') };
    if ($@){
        print {*STDERR} "problems with the line passed to _urlsafe_b64encode";
        return 0;
    }
    
    #The below URL-safe base64 decoding code is credited to the following:
    #http://search.cpan.org/~kazuho/MIME-Base64-URLSafe-0.01/lib/MIME/Base64/URLSafe.pm
    ####################################################################################
    my $data = encode_base64($line, '');
    $data =~ tr|+/=|\-_|d;
    ####################################################################################
    
    return $data;
}

sub _urlsafe_b64decode : Private {
    my $c = shift;
    my $t0 = [gettimeofday];
    _check_c($c);
    
    my $line = shift
        or do {
            _xml_status($c, $t0,
                request => {
                    status => 'ERROR',
                },
                response => {
                    status => 'Please hand a valid, URL-encoded base64 string '
                                .'to this resource, i.e. '
                                .'this resource, i.e. http://www.hursk.com/password/file/line/Ym9iOjEwNjA6QjBFQkYzNjdGNDlFMTM1NEI3OUFFMjYxMEREODlENEM6RUIyODEyQjFGRTEwRUU1MEU3OUI2QTU5NUM0NzZEQjI6OjoK\'',
                    HTTP_code => 400,
                    HTTP_status => 'Bad Request',
                }
            );
            return 0;
        };
    
    #The below URL-safe base64 decoding code is credited to the following:
    #http://search.cpan.org/~kazuho/MIME-Base64-URLSafe-0.01/lib/MIME/Base64/URLSafe.pm
    ####################################################################################
    # +/ should not be handled, so convert them to invalid chars
    # also, remove spaces (\t..\r and SP) so as to calc padding len
    $line =~ tr|\-_\t-\x0d |+/|d;
    my $mod4 = length($line) % 4;
    if ($mod4) {
	$line .= substr('====', $mod4);
    }
    ####################################################################################
    eval { decode_base64($line) };
    if ($@){
        _xml_status($c, $t0,
            request => {
                status => 'ERROR',
            },
            response => {
                status => 'Please hand a valid, URL-encoded base64 string '
                        .'to this resource, i.e. '
                        .'this resource, i.e. http://www.hursk.com/password/file/line/Ym9iOjEwNjA6QjBFQkYzNjdGNDlFMTM1NEI3OUFFMjYxMEREODlENEM6RUIyODEyQjFGRTEwRUU1MEU3OUI2QTU5NUM0NzZEQjI6OjoK\'',
                HTTP_code => 400,
                HTTP_status => 'Bad Request',
            }
        );
        return 0;
    }
    
    return decode_base64($line)
}

#Alias GET to POST so that they do the same thing (per S.O.W.)
no warnings;
*line_GET = \&line_POST;
use warnings;

sub _check_line : Private {
    my ($c, $line, @extra_args) = @_;
    my $t0 = [gettimeofday];
    
    _check_c($c);
    
    if (length $line > 1000){
        if ($@){
            _xml_status($c, $t0,
                request => {
                    status => 'ERROR',
                },
                response => {
                    status => 'Currently this resource does not handle base64 '
                            .'strings longer than 1000 characters.',
                    HTTP_code => 400,
                    HTTP_status => 'Bad Request',
                }
            );
            return 0;
        }
    }
    
    if (length $line < 5){
        if ($@){
            _xml_status($c, $t0,
                request => {
                    status => 'ERROR',
                },
                response => {
                    status => 'The line you send to this resource must be longer '
                            .'than 5 characters',
                    HTTP_code => 400,
                    HTTP_status => 'Bad Request',
                }
            );
            return 0;
        }
    }
    
    #Make sure input line is base64 regex checked:
    if ($line !~ /^[\w=]+$/ or @extra_args){
        _xml_status($c, $t0,
            request => {
                status => 'ERROR',
            },
            response => {
                status => 'Strange encoding detected. '
                        .'Please hand a valid, URL-encoded base64 string to '
                        .'this resource, i.e. http://www.hursk.com/password/file/line/Ym9iOjEwNjA6QjBFQkYzNjdGNDlFMTM1NEI3OUFFMjYxMEREODlENEM6RUIyODEyQjFGRTEwRUU1MEU3OUI2QTU5NUM0NzZEQjI6OjoK\'',
                HTTP_code => 400,
                HTTP_status => 'Bad Request',
            }
        );
        return 0;
    }
    
    return 1;
}

#YWNhZG0wMDQ6ckFPaWMwU3pPN1BpQToxMzAwMDowOjE0Ojo6Og
#A POST will NOT get content in return.
#If you GET what you POSTED, then you will get content in return.
sub line_POST :Args(1) {
    my ($self, $c, $line, @extra_args) = @_;
    my $t0_line_POST = [gettimeofday];
    
    return 0 unless _check_line($c, $line, @extra_args);
    
    my $URL_safe_base64_line = $line;
    
    #Analyze string for XML output:
    #Make line presentable for xml:
    my $cleartext_line_string
        = _urlsafe_b64decode($c, $line);
    return 0 unless $cleartext_line_string;
    
    my $html_entities_encoded_line
        = HTML::Entities::encode_entities( $cleartext_line_string );
    
    #If there were no HTML entities needing to be escaped...
    if ($html_entities_encoded_line eq $cleartext_line_string){
       #...we can store line as cleartext in XML
       #and don't need HTML entities or base64:
       $html_entities_encoded_line = undef;
       $URL_safe_base64_line = undef;
    }
    else {#...otherwise we can't store line as cleartext:
        $cleartext_line_string = undef;
    }
    
    
    
    #Decode url-encoded base64:
    $line = _urlsafe_b64decode($c, $line);
    return 0 unless $line;
    $line =~ s/(?:^\s*|\s*$)//;#Take off beginning/ending whitespace
    my @split = split /:/, $line;
    my $account_name = $split[0];#First thing before first colon is acct_name in ALL files
    
    #Check account name for length:
    if (length $account_name > 128){
        my $t0 = [gettimeofday];
        _xml_status($c, $t0,
            request => {
                status => 'ERROR',
            },
            response => {
                status => 'Account name over 128 characters not currently supported.',
                HTTP_code => 400,
                HTTP_status => 'Bad Request',
            }
        );
        return 0;
    }
    
    my $hash; 
    
    my $number_of_colon_splits = scalar @split;
    warn "NUMBER OF COLON SPLITS: $number_of_colon_splits \n";
    
    my $line_type;
    
    #It's either a passwd or dumpsec file if the number of colon splits is 7:
    if ($number_of_colon_splits == 7){
        
        #If the second colon-column is just numbers, it's a pwdump file:
        if ($split[1] =~ /^\d+$/){
            $hash = $split[2];#The hash is in the third colon-column
            $line_type = 'pwdump';
        }
        #If the third and fourth colon-column is just numbers, it's a passwd file:
        elsif ($split[2] =~ /^\d+$/ and $split[3] =~ /^\d+$/) {
            $hash = $split[1];#The hash is in the second colon-column
            $line_type = 'passwd';
        }
        else {
            my $t0 = [gettimeofday];
            _xml_status($c, $t0,
                request => {
                    status => 'ERROR',
                },
                response => {
                    status => 'Strange line format detected. '
                            .'Please hand a valid, single line of a '
                            .'passwd, shadow, or dumpsec file '
                            .'via a URL-encoded base64 string to '
                            .'this resource, i.e. http://www.hursk.com/password/file/line/Ym9iOjEwNjA6QjBFQkYzNjdGNDlFMTM1NEI3OUFFMjYxMEREODlENEM6RUIyODEyQjFGRTEwRUU1MEU3OUI2QTU5NUM0NzZEQjI6OjoK\'',
                    HTTP_code => 400,
                    HTTP_status => 'Bad Request',
                }
            );
            return 0;
        }
    }
    #It's a passwd file if the number of colon splits is 9:
    elsif ($number_of_colon_splits == 9){
        #If the third colon-column is just numbers, it's a shadow file:
        if ($split[2] =~ /^\d+$/){
            $hash = $split[1];#The hash is in the second colon-column
            $line_type = 'shadow';
        }
        else {
            my $t0 = [gettimeofday];
            _xml_status($c, $t0,
                request => {
                    status => 'ERROR',
                },
                response => {
                    status => 'Strange line format detected. '
                            .'Please hand a valid, single line of a '
                            .'passwd, shadow, or dumpsec file '
                            .'via a URL-encoded base64 string to '
                            .'this resource, i.e. http://www.hursk.com/password/file/line/Ym9iOjEwNjA6QjBFQkYzNjdGNDlFMTM1NEI3OUFFMjYxMEREODlENEM6RUIyODEyQjFGRTEwRUU1MEU3OUI2QTU5NUM0NzZEQjI6OjoK\'',
                    HTTP_code => 400,
                    HTTP_status => 'Bad Request',
                }
            );
            return 0;
        }
    }
    #Otherwise we don't know what type of file this is:
    else {
        my $t0 = [gettimeofday];
        _xml_status($c, $t0,
            request => {
                status => 'ERROR',
            },
            response => {
                status => 'Strange line format detected. '
                        .'Please hand a valid, single line of a '
                        .'passwd, shadow, or dumpsec file '
                        .'via a URL-encoded base64 string to '
                        .'this resource, i.e. http://www.hursk.com/password/file/line/Ym9iOjEwNjA6QjBFQkYzNjdGNDlFMTM1NEI3OUFFMjYxMEREODlENEM6RUIyODEyQjFGRTEwRUU1MEU3OUI2QTU5NUM0NzZEQjI6OjoK\'',
                HTTP_code => 400,
                HTTP_status => 'Bad Request',
            }
        );
        return 0;
    }
    
    #Check hash itself for length:
    if (length $hash > 500){
        my $t0 = [gettimeofday];
        _xml_status($c, $t0,
            request => {
                status => 'ERROR',
            },
            response => {
                status => 'Hash length over 500 characters not currently supported.',
                HTTP_code => 400,
                HTTP_status => 'Bad Request',
            }
        );
        return 0;
    }
    
    #If there is no password for the account ('NP')
    #or the account is locked ('*LK*')
    #or the password referenced in the passwd file ('x') is found in the shadow file,
    #then we don't need to check the DB to see
    #if we've already seen the hash (i.e. there is no hash)
    #otherwise we SHOULD check the db:
    
    #OK: So if someone does a GET for an '*LK*' or 'x' or 'NP' just return
    #that it's a locked password, the password is in the shadow file, or "no password"
    
    if (not $hash or $hash =~ /^\s*$/){
        _xml_status($c, $t0_line_POST,
                request => {
                    status => 'ERROR',
                    account_name => $account_name,
                    line => {
                        type => $line_type,
                        cleartext => $cleartext_line_string,
                        entities_encoded => $html_entities_encoded_line,
                        URLsafe_base64 => $URL_safe_base64_line,
                    },
                    hash => {
                        cleartext => '',
                    }
                },
                response => {
                    status => 'Could not find a hash in the password line that was sent to this resource. '
                             .'Please send a line of your passwd, shadow, or dumpsec file '
                             .'in URL-encoded base64 format.',
                    HTTP_code => 400,
                    HTTP_status => 'Bad Request',
                }
            );
        return 0;
    }else{}
    
    unless ($hash eq 'x'
            or $hash eq '*LK*'
            or $hash eq 'NP'
            ){
        my $hash_in_db = $c->model('password_rest_service::Hashes')->
                        find({hash => $hash});
        if ($hash_in_db){
            my $cleartext_password = $hash_in_db->retrieved_password;
            
            my $cleartext_hash_string;
            my $html_entities_encoded_hash;
            my $URL_safe_base64_hash;
            
            #Make hash presentable for xml:
            $URL_safe_base64_hash
                = _urlsafe_b64encode($c, $hash);
            return 0 unless $URL_safe_base64_hash;
            
            $html_entities_encoded_hash
            = HTML::Entities::encode_entities($hash);
            
            #If there were no HTML entities needing to be escaped...
            if ($html_entities_encoded_hash eq $hash){
               #...we can store hash as cleartext in XML
               #and don't need HTML entities or base64:
               $cleartext_hash_string = $hash;
               $html_entities_encoded_hash = undef;
               $URL_safe_base64_hash = undef;
            }
            else {
                #...otherwise we can't store hash as cleartext:
                $cleartext_hash_string = undef;
            }
            
            my $password_status;
            my $status = "The requested hash was found in our database ";
            
            my $URL_safe_base64_password;
            my $html_entities_encoded_password;
            my $cleartext_password_string;
            
            if ($cleartext_password){
                
                $status .= "and the corresponding password has been returned.";
                $password_status = 'cracked';
                
                $URL_safe_base64_password
                    = _urlsafe_b64encode($c, $cleartext_password);
                return 0 unless $URL_safe_base64_password;
                
                $html_entities_encoded_password
                = HTML::Entities::encode_entities($cleartext_password);
                
                #If there were no HTML entities needing to be escaped...
                if ($html_entities_encoded_password eq $cleartext_password){
                   #...we can store as cleartext in XML
                   #and don't need HTML entities or base64:
                   $cleartext_password_string = $cleartext_password;
                   $html_entities_encoded_password = undef;
                   $URL_safe_base64_password = undef;
                }
                else {
                    #...otherwise we should store an HTML entities encoded version
                    $cleartext_password_string = undef;
                }
            }
            else {
                $status .= "but we were unable to crack it.";
                $password_status = 'uncracked';
            }
            
            _xml_status($c, $t0_line_POST,
                request => {
                    status => 'OK',
                    account_name => $account_name,
                    line => {
                        type => $line_type,
                        cleartext => $cleartext_line_string,
                        entities_encoded => $html_entities_encoded_line,
                        URLsafe_base64 => $URL_safe_base64_line,
                    },
                    hash => {
                        cleartext => $cleartext_hash_string,
                        entities_encoded => $html_entities_encoded_hash,
                        URLsafe_base64 => $URL_safe_base64_hash,
                    }
                },
                response => {
                    status => $status,
                    HTTP_code => 200,
                    HTTP_status => 'OK',
                    password => {
                        status => $password_status,
                        cleartext => $cleartext_password_string,
                        entities_encoded => $html_entities_encoded_password,
                        URLsafe_base64 => $URL_safe_base64_password,
                    },
                }
            );
            return;# no need to process any further.
        }
        else {
            #Keep processing....
        }
    }
    else {
        #If the account is locked, has no password,
        #or is instead ref'd in the shadow file
        #no need to process any further:
        my $status;
        my $HTTP_code = 200;
        my $HTTP_status = 'OK';
        my $request_status = 'OK';
        my $cleartext_password;
        
        if ($hash eq 'x'){
            $status = 'hash is referenced in shadow file'
        }
        elsif ($hash eq '*LK*'){
            $status = 'account is locked'
        }
        elsif ($hash eq 'NP'){
            $status = 'no password for account'
        }
        else {
            $status = 'unknown error';
            $HTTP_code = 500;
            $HTTP_status = 'Internal Server Error';
            $request_status = 'ERROR';
        }
        
        _xml_status($c, $t0_line_POST,
             request => {
                status => 'OK',
                account_name => $account_name,
                line => {
                        type => $line_type,
                        cleartext => $cleartext_line_string,
                        entities_encoded => $html_entities_encoded_line,
                        URLsafe_base64 => $URL_safe_base64_line,
                    },
                hash => {
                    cleartext => $hash,
                }
            },
            response => {
                status => $status,
                HTTP_code => $HTTP_code,
                HTTP_status => $HTTP_status,
                password => {
                    status => $hash,
                },
            }
        );
        return;# no need to process any further.
    }
    
    #If you fork without ever waiting on your children,
    #you will accumulate zombies. On some systems (up-to-date/standard UNIX),
    #you can avoid this by setting $SIG{CHLD}  to "IGNORE" .
    $SIG{CHLD} = 'IGNORE';
    
    #XXX: AUGMENT PROCESS_LOAD here *IN DATABASE*:
    my $john_process_id_result_set
        = $c->model('password_rest_service::SharedVars')
            ->new({});#Prepare auto-increment
    $john_process_id_result_set->insert;#auto-increment
    
    my $john_process_id = $john_process_id_result_set->id;#Gets the auto-incremented val just inserted
    
    warn "Before processing, john_process_id is ".$john_process_id_result_set->id."\n";
    
    #This is child process:
    my $t0 = [gettimeofday];
    open FH, ">>", '/tmp/john_the_ripper.log';
    print FH "ID:$john_process_id:START:".time."\n"; close FH;
    #Fork a separate process without blocking the call:
    defined( my $pid = fork() ) or die "Can't fork in File.pm"; 
    if( $pid == 0 ){
        chdir '/'                   or die "Can't chdir to /: $!";
        open STDIN, '/dev/null'     or die "Can't read /dev/null: $!";
        open STDOUT, '>/dev/null'   or die "Can't write to /dev/null: $!";
        open STDERR, '>/tmp/log'    or die "Can't write to /tmp/log: $!";
        setsid                      or die "Can't wtart a new session: $!";
        
        my $oldfh = select STDERR;
        local $| = 1;
        select $oldfh;
        warn "started JTR child process\n";
        
        #JTR will do its thing and output results to the DB when done.
        my ($result, $status, $error) = _process_line_with_john($c, $line);
        my $time_interval = tv_interval( $t0_line_POST );
        
        if (not $error or $error =~ /^\s*$/){ $error = 'none' }
        
        #Temporary for now:
        my $retrieved_password;
        
        #If there were 0 password hashes cracked as reported by JTR,
        #then there was no retrieved password.
        #Otherwise, there *was* a retrieved password:
        if ($result !~ /^\s* 0 \s+ password \s+ hashes \s+ cracked/ix){
             $retrieved_password = $result;
        }
        
        #Store entry in DB like this:
        #hash (primary key), status, retrieved_password, error
        my $hash_in_db = $c->model('password_rest_service::Hashes')->
                             create({hash => $hash,
                                     result => $result,
                                     status => $status,
                                     retrieved_password => $retrieved_password,
                                     error => $error,
                                    });
        
        #XXX: Decrement the application's process_load *IN DATABASE* when done:
        $john_process_id_result_set->delete;
        
        warn "John process has completed in ".tv_interval( $t0 )." seconds";
        open FH, ">>", '/tmp/john_the_ripper.log';
        print FH "ID:$john_process_id:STOP:".time.":INTERVAL:".tv_interval( $t0 )."\n"; close FH;
        
        CORE::exit(0);
    }else{}
    
    _xml_status($c, $t0_line_POST,
        request => {
            status => 'OK',
            account_name => $account_name,
            line => {
                type => $line_type,
                cleartext => $cleartext_line_string,
                entities_encoded => $html_entities_encoded_line,
                URLsafe_base64 => $URL_safe_base64_line,
            },
            hash => {
                cleartext => $hash,
            }
        },
        response => {
            status => "processing",
            HTTP_code => 202,
            HTTP_status => 'Accepted',
       }
    );
    
}

sub _xml_status : Private {
    my ($c, $t0, %args) = @_;
    _check_c($c);
    
    no strict 'refs';
    my $request_status = $args{request}{status}
        unless not exists($args{request}{status});
    my $request_account_name = $args{request}{account_name}
        unless not exists($args{request}{account_name});
    
    my $request_line_type = $args{request}{line}{type}
        unless (
            not exists($args{request}{line})
            or not exists($args{request}{line}{type})
        );
    my $request_line_cleartext = $args{request}{line}{cleartext}
        unless (
            not exists($args{request}{line})
            or not exists($args{request}{line}{cleartext})
        );
    my $request_line_entities_encoded = $args{request}{line}{entities_encoded}
        unless (
            not exists($args{request}{line})
            or not exists($args{request}{line}{entities_encoded})
        );
    my $request_line_URLsafe_base64 = $args{request}{line}{URLsafe_base64}
        unless (
            not exists($args{request}{line})
            or not exists($args{request}{line}{URLsafe_base64})
        );    
    
    my $request_hash_cleartext = $args{request}{hash}{cleartext}
        unless (
            not exists($args{request}{hash})
            or not exists($args{request}{hash}{cleartext})
        );
    my $request_hash_entities_encoded = $args{request}{hash}{entities_encoded}
        unless (
            not exists($args{request}{hash})
            or not exists($args{request}{hash}{entities_encoded})
        );
    my $request_hash_URLsafe_base64 = $args{request}{hash}{URLsafe_base64}
        unless (
            not exists($args{request}{hash})
            or not exists($args{request}{hash}{URLsafe_base64})
        );    
        
    my $response_status = $args{response}{status}
        unless not exists($args{response}{status});
    my $response_process_load = $args{response}{process_load}
        unless not exists($args{response}{process_load});
    my $response_HTTP_code = $args{response}{HTTP_code}
        unless not exists($args{response}{HTTP_code});
    my $response_HTTP_status = $args{response}{HTTP_status}
        unless not exists($args{response}{HTTP_status});
    
    my $response_password_status = $args{response}{password}{status}
        unless (
            not exists($args{response}{password})
            or not exists($args{response}{password}{status})
        );
    my $response_password_cleartext = $args{response}{password}{cleartext}
        unless (
            not exists($args{response}{password})
            or not exists($args{response}{password}{cleartext})
        );
    my $response_password_entities_encoded = $args{response}{password}{entities_encoded}
        unless (
            not exists($args{response}{password})
            or not exists($args{response}{password}{entities_encoded})
        );
    my $response_password_URLsafe_base64 = $args{response}{password}{URLsafe_base64}
        unless (
            not exists($args{response}{password})
            or not exists($args{response}{password}{URLsafe_base64})
        );    
    
    unless ( $response_status and $request_status){
        die "request_status or response_status not passed to _xml_status function. Both must be passed."
    }
    unless ( $response_HTTP_code ){
        die "\$HTTP_code not passed to _xml_status function"
    }
    
    use strict 'refs';
    
    #Create xml status output:
    #Create a new XML::Twig object:
    my $t = XML::Twig->new()->parse('<?xml version="1.0" encoding="UTF-8"?><password_cracker></password_cracker>');
    #Get the <password_cracker> element
    my $password_cracker = $t->child(0);
    #Set it as the root element:
    $t->set_root($password_cracker);
    #Set its version attribute
    $password_cracker->set_att( version => $VERSION);
    
    #Create request elt:
    my $request_elt = XML::Twig::Elt->new('request');
    $request_elt->paste_last_child($password_cracker);
    
        #Create request_status elt:
        my $request_status_elt = XML::Twig::Elt->new('status');
        if ($request_status){#Fill in the status elt if there is an status
            $request_status_elt->set_content($request_status);
        }
        $request_status_elt->paste_last_child($request_elt);
        
        #Create request_account_name elt:
        my $request_account_name_elt = XML::Twig::Elt->new('account_name');
        if ($request_account_name){#Fill in the status elt if there is an status
            $request_account_name_elt->set_content($request_account_name);
        }
        $request_account_name_elt->paste_last_child($request_elt);
        
        #Create request_line elt:
        my $request_line_elt = XML::Twig::Elt->new('line');
        $request_line_elt->paste_last_child($request_elt);
            
            #Create request_line_type elt:
            my $request_line_type_elt = XML::Twig::Elt->new('type');
            if ($request_line_type){#Fill in the element data if there is any
                $request_line_type_elt->set_content($request_line_type);
            }
            $request_line_type_elt->paste_last_child($request_line_elt);
            
            #Create request_line_cleartext elt:
            my $request_line_cleartext_elt = XML::Twig::Elt->new('cleartext');
            if ($request_line_cleartext){#Fill in the element data if there is any
                $request_line_cleartext_elt->set_content($request_line_cleartext);
            }
            $request_line_cleartext_elt->paste_last_child($request_line_elt);
            
            #Create request_line_entities_encoded elt:
            my $request_line_entities_encoded_elt = XML::Twig::Elt->new('entities_encoded');
            if ($request_line_entities_encoded){#Fill in the element data if there is any
                $request_line_entities_encoded_elt->set_content($request_line_entities_encoded);
            }
            $request_line_entities_encoded_elt->paste_last_child($request_line_elt);
            
            #Create request_line_URLsafe_base64 elt:
            my $request_line_URLsafe_base64_elt = XML::Twig::Elt->new('URLsafe_base64');
            if ($request_line_URLsafe_base64){#Fill in the element data if there is any
                $request_line_URLsafe_base64_elt->set_content($request_line_URLsafe_base64);
            }
            $request_line_URLsafe_base64_elt->paste_last_child($request_line_elt);
        
        #Create request_hash elt:
        my $request_hash_elt = XML::Twig::Elt->new('hash');
        $request_hash_elt->paste_last_child($request_elt);
            
            #Create request_hash_cleartext elt:
            my $request_hash_cleartext_elt = XML::Twig::Elt->new('cleartext');
            if ($request_hash_cleartext){#Fill in the element data if there is any
                $request_hash_cleartext_elt->set_content($request_hash_cleartext);
            }
            $request_hash_cleartext_elt->paste_last_child($request_hash_elt);
            
            #Create request_hash_entities_encoded elt:
            my $request_hash_entities_encoded_elt = XML::Twig::Elt->new('entities_encoded');
            if ($request_hash_entities_encoded){#Fill in the element data if there is any
                $request_hash_entities_encoded_elt->set_content($request_hash_entities_encoded);
            }
            $request_hash_entities_encoded_elt->paste_last_child($request_hash_elt);
            
            #Create request_hash_URLsafe_base64 elt:
            my $request_hash_URLsafe_base64_elt = XML::Twig::Elt->new('URLsafe_base64');
            if ($request_hash_URLsafe_base64){#Fill in the element data if there is any
                $request_hash_URLsafe_base64_elt->set_content($request_hash_URLsafe_base64);
            }
            $request_hash_URLsafe_base64_elt->paste_last_child($request_hash_elt);
    
    #Create response elt:
    my $response_elt = XML::Twig::Elt->new('response');
    $response_elt->paste_last_child($password_cracker);
    
        #Create response_process_load elt IF we are reporting on the process_load:
        if ($response_process_load){
            my $response_process_load_elt = XML::Twig::Elt->new('process_load');
            $response_process_load_elt->set_content( $response_process_load );
            $response_process_load_elt->paste_last_child( $response_elt );
        }
        
        #Create response_HTTP_status elt:
        my $response_status_elt = XML::Twig::Elt->new('status');
        $response_status_elt->set_content( $response_status );
        $response_status_elt->paste_last_child($response_elt);
        
        #Create response_HTTP_code elt:
        my $response_HTTP_code_elt = XML::Twig::Elt->new('HTTP_code');
        $response_HTTP_code_elt->set_content( $response_HTTP_code );
        $response_HTTP_code_elt->paste_last_child($response_elt);
        
        #Create response_HTTP_status elt:
        my $response_HTTP_status_elt = XML::Twig::Elt->new('HTTP_status');
        $response_HTTP_status_elt->set_content( $response_HTTP_status );
        $response_HTTP_status_elt->paste_last_child($response_elt);
    
        #Create response_password elt:
        my $response_password_elt = XML::Twig::Elt->new('password');
        $response_password_elt->paste_last_child($response_elt);
        
            #Create response_password_status elt:
            my $response_password_status_elt = XML::Twig::Elt->new('status');
            if ($response_password_status){#Fill in the element data if there is any
                $response_password_status_elt->set_content($response_password_status);
            }
            $response_password_status_elt->paste_last_child($response_password_elt);
        
            #Create response_password_cleartext elt:
            my $response_password_cleartext_elt = XML::Twig::Elt->new('cleartext');
            if ($response_password_cleartext){#Fill in the element data if there is any
                $response_password_cleartext_elt->set_content($response_password_cleartext);
            }
            $response_password_cleartext_elt->paste_last_child($response_password_elt);
            
            #Create response_password_entities_encoded elt:
            my $response_password_entities_encoded_elt = XML::Twig::Elt->new('entities_encoded');
            if ($response_password_entities_encoded){#Fill in the element data if there is any
                $response_password_entities_encoded_elt->set_content($response_password_entities_encoded);
            }
            $response_password_entities_encoded_elt->paste_last_child($response_password_elt);
            
            #Create response_password_URLsafe_base64 elt:
            my $response_password_URLsafe_base64_elt = XML::Twig::Elt->new('URLsafe_base64');
            if ($response_password_URLsafe_base64){#Fill in the element data if there is any
                $response_password_URLsafe_base64_elt->set_content($response_password_URLsafe_base64);
            }
            $response_password_URLsafe_base64_elt->paste_last_child($response_password_elt);
    
    #Clock response time:
    $response_elt->set_att( time_seconds => tv_interval( $t0 ) );
    
    $c->res->content_type('application/xml');
    $c->res->body( $t->toString );
    return;
}

sub _check_c : Private {
    my $c = shift;
    my $pkg_head = __PACKAGE__;
    if ($pkg_head =~ /^(\w+)::/){
        $pkg_head = $1
    }
    else {
        die "Unknown matching error while matching package"
    }
    die "Please pass \$c to function, this is what we have for c currently: $c"
        unless scalar $c =~ /^$pkg_head/;
}

sub _process_line_with_john: Private {
    my ($c, $decoded_line) = @_;
    
    my ($fh, $filename) = tempfile();
    open $fh, ">", $filename;
    print $fh $decoded_line;
    close $fh;
    
    my $john_exe = $c->config->{resources}{password}{file}{john_the_ripper}{executable_location};
    my $word_list = $c->config->{resources}{password}{file}{john_the_ripper}{word_list_location};
    die "ERROR: Word list not configured or not found for JTRipper!" if (not $word_list or not -f $word_list);
    die "ERROR: JTRipper executable not configured or not found!" if (not $john_exe or not -f $john_exe);
    die "ERROR: JTRipper executable does not have exec permissions for the caller!" if (not -x $john_exe);
    
    #Take off begin/end whitespace:
    $john_exe =~ s/(^\s*|\s*$)//g;
    $word_list =~ s/(^\s*|\s*$)//g;
    
    my ($error_fh, $error_filename) = tempfile();
    my $status = `$john_exe --single $filename 2> $error_filename`;
    $status .= `$john_exe --wordlist=$word_list $filename 2>> $error_filename`;
    my $result .= "\n".`$john_exe --show $filename 2>> $error_filename`;
    
    #Return any errors:
    my $error;
    open $error_fh, "<", $error_filename;
    while (<$error_fh>){$error .= $_}
    
    print STDERR $error;
    
    $result =~ s/(?:^[\s\n]*|[\s\n]*$)//;#Take off beginning/ending newlines/spaces
    $status =~ s/(?:^[\s\n]*|[\s\n]*$)//;#Take off beginning/ending newlines/spaces
    
    #JTR will say it has "1 left" with regards to passwords to crack,
    #but we are infact done processing this password hash, so let's take off
    #this message:
    $result =~ s/\s*,\s*\d+\s*left\s*$//;
    
    return ($result, $status, $error);
}

=head1 AUTHOR

Seth Viebrock

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

__PACKAGE__->config(
    'default'   => 'text/xml',
    'stash_key' => 'rest',
    'map'       => {
        'text/html'          => [ 'View', 'HTML', ],
        'text/xml'        => [ 'View', 'HTML', ],
        'text/x-yaml'        => 'YAML',
        'text/xml' => [ 'Data::Serializer', 'XML::Simple' ],
        'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
    },
);

1;